home *** CD-ROM | disk | FTP | other *** search
- <<< trsdata.mac >>>
- subttl data segment
- dseg
- ;
- ; state symbols
- ;
- _a equ 1 ;abort
- _c equ 2 ;complete
- _r equ 3 ;receive init
- _rf equ 4 ;receive file header
- _rd equ 5 ;receive data
- _s equ 6 ;send init
- _sf equ 7 ;send file header
- _sd equ 8 ;send data
- _se equ 9 ;send end-of-file
- _sb equ 10 ;send break transmission
- _o equ 11 ;open file (pre send init)
- _end equ 255
- ;
- public fcb,filbuf,recptr,recbuf,paraml,lrecl
- public create,byte,word,screen,rftab,rdtab
- public slen,spaket,rlen,rpaket,sinit
- public rinit,port,baud,wdlen,baudtb,lab,parsetb
- public parity,stop,oldstk,scrtch,cmdlin,high
- public state,n,r,init,ssvc,rsvc,csvc,altsvc
- public nsvc,stack,stjump,rtype
- extrn abort,exit,r_init,r_file,r_data
- extrn rf_f,rf_b,rf_x,rd_d,rd_z
- extrn s_open,s_file,s_data,s_eof,s_break,s_init
- public filnam,crp,cbp,work
- extrn eof,sets,setr,setb,setf,setp,setc,setw,seter
- extrn setl
- ;
- ; fcb and others file related matters
- ;
- filnam: ds 30 ;will hold filename for send
- fcb: ds 60 ;file control block
- filbuf: ds 512 ;file buffer
- crp:
- recptr: db 0 ;
- recbuf: ds 256 ;record buffer
- paraml: dw filbuf ;parameter list for file svc's
- dw recbuf
- dw eof ;send end of file routine
- db 'W' ;read/write
- lrecl: db 1 ;default is 1
- db 'F' ;always fixed record length
- create: db 2 ;default is create
- db 0 ;user attrib = 0
- ;
- ; packet buffers
- ;
- cbp:
- slen: db 0 ;send buffer length (all included)
- spaket: ds 100 ;send packet
- rlen: db 0 ;receive buffer length
- rpaket: dw 0 ;receive packet store
- rtype: ds 100 ;here is where we store type
- ;
- ; the send init exchange
- ;
- sinit: db 13 ;will contain the send init received
- db 13,13,13,13,13,13,13,13,13,13,13
- maxlen equ 94 ;maximum packet length
- tout equ 10 ;time out
- quote equ '#'
- cr equ 13 ;carriage return (eol)
- rinit: ;the send-init we will send
- db maxlen+32
- db tout+32
- db 0+32
- db 64
- db cr+32 ;eol
- db quote
- db 'N'
- db '1'
- db ' '
- db 32
- ; telecomm buffers
- ;
- port: db 'A' ;default is A
- baud: db 8 ;baud rate (9600)
- wdlen: db 8 ;8 bits' byte
- parity: db 'N' ;none
- stop: db 1
- db 0 ;end
- ;
- ; misc
- ;
- oldstk: dw 0 ;save stack here on entry
- scrtch: dw 0 ;last+1 byte of pgm on entry
- cmdlin: dw 0 ;address of command line
- byte: db 0 ;scratch byte
- word: dw 0 ;scratch word
- work: ;work space for parser
- db '0','0','0','0','0'
- screen: db 0 ;flag for typing on screen
- ;
- high: dw 0 ;high memory
- state: db 3 ;current state of automaton
- n: db 0 ;current packet number
- r: db 0 ;current retry count
- init: db 0 ;do comm init on entry if != 0
- ;
- ; svc for comm operations
- ;
- ssvc: db 97 ;send on channel A
- rsvc: db 96 ;receive on channel A
- csvc: db 100 ;control on channel A
- altsvc: db 0,99,98,101 ;same for channel B
- nsvc: db 4 ;number of bytes to move
- ;
- ; stack
- ;
- ds 400 ;lots of space
- stack:
- stjump: db _a ;main jump table
- dw abort
- db _c
- dw exit
- db _r
- dw r_init
- db _rf
- dw r_file
- db _rd
- dw r_data
- db _o
- dw s_open
- db _s
- dw s_init
- db _sf
- dw s_file
- db _sd
- dw s_data
- db _se
- dw s_eof
- db _sb
- dw s_break
- db _end ;end of table
-
- rftab: db _a
- dw abort
- db 'F'
- dw rf_f
- db 'B'
- dw rf_b
- db 'X'
- dw rf_x
- db _end
-
- rdtab: db _a
- dw abort
- db 'D'
- dw rd_d
- db 'Z'
- dw rd_z
- db _end
- ;
- baudtb:
- db '110 ',1
- db '150 ',2
- db '300 ',3
- db '600 ',4
- db '1200',5
- db '2400',6
- db '4800',7
- db '9600',8
- db 13 ;end of table
- lab:
- dw l1,l2,0
- l1:
- db 3,'{}',13
- l2:
- db 1,'/'
- parsetb:
- db 0
- dw seter
- db 'W'
- dw setw
- db 'S'
- dw sets
- db 'R'
- dw setr
- db 'F'
- dw setf
- db 'P'
- dw setp
- db 'B'
- dw setb
- db 'C'
- dw setc
- db 'L'
- dw setl
- db _end
- end
- <<< trsmain.mac >>>
- subttl kmain/mac main parser and initialization routin
- cseg
- extrn oldstk,scrtch,high,cmdlin,stack,stjump,lab
- extrn rftab,rdtab,rtype,abort,parity,port,fcb,baud
- extrn wdlen,baudtb,parsetb,byte,initcm,init,state
- public mjump,rdjump,rfjump,sets,setr,setf,setb,setp,setc
- public setw,seter,setl
- extrn lrecl,filnam,paraml,work
- ;
- ; macros
- ;
- ; prmes to display a message stored by mssg
- ; call prmes lab
- ;
- prmes macro lab
- .xlist
- extrn m_&lab,l_&lab
- push hl
- push bc
- ld hl,m_&lab
- ld bc,(l_&lab)
- ld c,13
- ld a,9
- rst 8
- pop bc
- pop hl
- .list
- endm
- ;
- ; jumptb jump according to a jump table
- ; call jumptb table,code
- ; where table is the address of the table
- ; and code is a one-byte code
- ;
- jumptb macro table,code
- .xlist
- local $1
- ld hl,table
- ld bc,(code)
- ld b,c
- ld a,28 ;lookup call
- rst 8 ;dos
- jr z,$1 ;no error
- ld hl,table+1 ;get abort address (first entry)
- $1:
- jp (hl)
- .list
- endm
- ;
- ; main entry save usefull registers
- ;
- start:
- ld (oldstk),sp ;save stack
- ld (scrtch),bc ;first byte after pgm
- ld (high),de ;high memory
- ld (cmdlin),hl ;command line
- ld sp,stack ;new stack
- ;
- ; main parsing routine
- ; will respond to the following syntax :
- ; KERMIT {S,F=file,B=baud,P=par,W=word,C=channel}
- ; update {L=lrecl} 85.09.19
- ;
- iparse:
- ld e,0 ;init for first call nxtfld
- ld hl,(cmdlin) ;get command line
- ld c,(hl) ;maximum length to parse
- inc hl ;points to first byte
- i0:
- ld a,(hl) ;get first byte
- cp ' ' ;white space ?
- jr z,i1 ;yes, now find {
- dec c ;decrement length to parse
- inc hl ;update pointer
- ld a,c ;length in a
- cp 0 ;is it null ?
- jr nz,i0 ;no, go on
- jp go ;yes, no parse to be done
- i1:
- dec c ;decrement length to parse
- inc hl ;update pointer
- ld a,c ;get length in a
- cp 0 ;is it null ?
- jp z,go ;nothing to parse
- ld a,(hl) ;get byte in a
- cp ' ' ;is it another null ?
- jp z,i1 ;yes, get one more
- cp '{' ;is it valid start ?
- jp nz,seter ;no good
- dec c ;decrement length
- inc hl ;update pointer
- ld a,c ;get length in a
- cp 0 ;is it null ?
- jp z,seter ;no good
- parse:
- call nxtfld ;get next field
- jp nz,go ;go !
- ld a,b ;length of field
- cp 0 ;is it null ?
- jp z,seter ;disaster ...
- call handler ;work with this parameter
- ld a,c ;length left to parse
- or a ;is it null ?
- jp nz,parse ;no, do it again
- ld a,0FFH ;terminator ?
- cp d ;in register D
- jp z,seter ;yes and parse is incomplete
- jp go ;go !
- handler:
- ld a,(hl) ;get first caracter of field
- ld (byte),a ;in byte
- push hl ;save
- push bc
- jumptb parsetb,byte ;jump accordingly
- sets:
- pop bc
- pop hl
- ld a,11 ;open pseudo-state
- ld (state),a ;set send state
- ld a,'R' ;read only
- ld (paraml+6),a ;put fcb in read state
- ld a,0 ;do not create
- ld (paraml+9),a ;and do not create
- ret
- setr:
- pop bc
- pop hl
- ld a,3
- ld (state),a ;set receive state
- ret
- setf:
- pop bc
- pop hl
- call nxtfld ;get next field
- push hl ;save
- push de
- push bc
- push hl ;i will need it twice
- ld a,b ;get length in a
- cp 0 ;is it null ?
- jp z,f0 ;yes error
- cp 30 ;greater than 30
- jp nc,f0 ;yes, error
- ld de,fcb ;where filaname should be
- ld c,b ;with length in BC
- ld b,0
- ldir ;move from hl to de
- ex de,hl ;end of filnam in hl
- ld (hl),13 ;put in a CR
- ld (filnam),a ;get filename length in place
- ld de,filnam ;to filenam
- inc de ;plus one (first byte is len)
- pop hl ;from here
- ld c,a ;length in bc
- ld b,0
- ldir ;move from param list to filnam
- ex de,hl ;hl points to end
- ld (hl),13 ;put in a CR
- pop bc ;restore
- pop de
- pop hl
- ret
- f0:
- prmes e4 ;not valid filename
- jp abort ;end in disaster
- setp:
- pop bc
- pop hl
- call nxtfld ;get next field
- ld a,(hl) ;get first byte in a
- cp 'O' ;is it odd
- jr nz,p0 ;no ...
- ld (parity),a ;set in comm buffer
- ld (init),a ;init flag
- ret
- p0:
- cp 'E' ;is it even ?
- jr nz,p1 ;no ...
- ld (parity),a ;set in comm buffer
- ld (init),a ;init flag
- ret
- p1:
- cp 'N' ;is it none ?
- jr nz,p2 ;no, error
- ld (parity),a ;set in comm buffer
- ld (init),a ;init flag
- ret
- p2:
- prmes e5 ;invalid parity
- jp abort ;end in disaster
- setb:
- pop bc
- pop hl
- call nxtfld ;get next field
- push hl ;save
- push de
- push bc
- ex de,hl ;de=compare string
- ld hl,baudtb ;baud rate table
- ld a,49 ;svc scan
- rst 8 ;dos
- jr nz,b0 ;not found
- inc hl ;increment to code
- inc hl
- inc hl
- inc hl
- ld a,(hl) ;get code in a
- ld (baud),a ;in comm buffer
- ld (init),a ;init flag
- pop bc ;restore
- pop de
- pop hl
- ret
- b0:
- prmes e6 ;unsupported baud rate
- jp abort ;in disaster
- setw:
- pop bc
- pop hl
- call nxtfld ;get next field
- ld a,(hl) ;first byte in a
- cp '7' ;is it 7
- jr nz,w0 ;no, try 8
- sub '0' ;convert to binary
- ld (wdlen),a ;in comm buffer
- ld (init),a ;set init flag
- ret
- w0:
- cp '8' ;is it 8
- jr nz,w1 ;no, error
- ld (wdlen),a ;in comm buffer
- ld (init),a ;init flag
- ret
- w1:
- prmes e7 ;bad word length
- jp abort ;disaster
- setc:
- pop bc
- pop hl
- call nxtfld ;get next field
- ld a,(hl) ;first byte in a
- cp 'A' ;is it cnannel A ?
- jr nz,c0 ;no, try B
- ld (port),a ;in comm buffer
- ld (init),a ;init flag
- ret
- c0:
- cp 'B' ;is it B
- jr nz,c1 ;no, error
- ld (port),a ;in comm buffer
- ld (init),a ;init flag
- ret
- c1:
- prmes e8 ;invalid channel
- jp abort ;disaster
- seter:
- pop bc
- pop hl
- prmes e9 ;invalid parameter
- prmes u0 ;usage is...
- jp abort ;disaster
- setl:
- pop bc ;restore
- pop hl
- call nxtfld ;get record length
- push hl ;save
- push bc
- push de
- ld de,work ;to store value and padd
- ld a,b ;get length
- cp 6 ;maximum lebgth + 1
- jp nc,seter ;no good ... bye
- l0:
- cp 5 ;maximum length
- jr z,l1 ;finished moving
- inc a ;increase length
- inc de ;and pointer
- jr l0
- l1:
- ld c,b ;get length in bc
- ld b,0
- ldir ;move to work+(5-bc)
- ld hl,work ;get hl to point correctly
- ld b,1 ;code to convert to bin
- ld a,21 ;BINDEC svc
- rst 8 ;dos
- ld a,e ;get binary value
- ld (lrecl),a ;save in fcb
- pop de ;restore
- pop bc
- pop hl
- ret
- nxtfld:
- ld d,0 ;initialize de to e
- add hl,de ;add to hl - where to start
- ld de,lab ;list address block
- ld a,46 ;parse svc
- rst 8 ;dos
- ret
- go:
- call initcm ;initialize comm channel
- prmes 00 ;now say hello
- ; here is the main jump, every routine ends here
- ;
- mjump:
- jumptb stjump,state
- ;
- ;
- ;
- ; and this is the main receive file jump
- ;
- rfjump:
- jumptb rftab,rtype
- ;
- ; and the main receive data jump
- ;
- rdjump:
- jumptb rdtab,rtype
- ;
- end start
- <<< trsmssg.mac >>>
- subttl messages (because the assembler is too dumb)
- dseg
- ;
- ;
- ;mssg to reserve space for a message and it's length
- ; syntax mssg lab,<message>
- ; where lab is a maximum of four bytes
- ;
- mssg macro lab,mess
- .xlist ;do not list expansion
- public m_&lab,l_&lab
- m_&lab:
- db '&mess'
- l_&lab: db 0
- db $-m_&lab
- .list
- endm
- ;
- ; the message that should appear
- ;
- mssg 00,<Kermit (trsdos II, version 1.2)>
- mssg a0,<aborting due to fatal error>
- mssg u0,<KERMIT {(S,R),F=filename,B=baud,P=par,L=lrecl,C=channel}>
- mssg e0,<Kermit exit>
- mssg db0,<jumping from mjump>
- mssg db1,<jumping from rfjump>
- mssg db2,<jumping from rdjump>
- mssg db3,<entering receive-init>
- mssg db4,<entering receive-file>
- mssg db5,<entering receive-data>
- mssg db6,<entering rpack>
- mssg db7,<entering spack>
- mssg db8,<exiting timer call>
- mssg db9,<entering rp1>
- mssg db10,<entering rp2>
- mssg db11,<entering rp3>
- mssg db12,<entering rp4>
- mssg db13,<entering rp5>
- mssg db14,<entering rp6>
- mssg e3,<invalid word length>
- mssg e4,<invalid filename>
- mssg e5,<invalid parity>
- mssg e6,<unsupported baud rate>
- mssg e7,<invalid word length>
- mssg e8,<invalid channel>
- mssg e9,<invalid parameter>
- end
- <<< trsrecv.mac >>>
- title krecv/mac reception unit
- cseg
- ;
- ;
- extrn recptr,recbuf,rplus,mjump,rfjump,rdjump
- extrn spaket,rpaket,screen
- extrn rplus,sinit,state,byte,n,r
- extrn rpack,spack,abort,acsum,flush
- extrn fcb,writnx,open,rinit,close
- extrn lrecl
- public r_init,r_file,rf_b,rf_x,rf_f
- public r_data,rd_z,rd_d
- ;
- len equ 0
- seq equ 1
- type equ 2
- data equ 3
- quote equ '#'
- _a equ 1
- _c equ 2
- _r equ 3
- _rf equ 4
- _rd equ 5
- ;
- ;
- subttl macros used in this module
- ;
- ;prmes to display messages
- ;
- prmes macro lab
- .xlist
- extrn m_&lab,l_&lab
- push hl
- push bc
- ld hl,m_&lab
- ld bc,(l_&lab)
- ld c,13
- ld a,9
- rst 8
- pop bc
- pop hl
- .list
- endm
- ;movb
- ;
- movb macro value,loc
- .xlist
- push af
- ld a,value
- ld (loc),a
- pop af
- .list
- endm
- ;
- ;blmov
- ;
- blmov macro source,dest,len
- .xlist
- local $1,$2
- push hl
- push bc
- push de
- ld hl,source
- ld de,dest
- ld a,(len)
- cp 0
- jr nz,$1
- ld b,1
- ld c,0
- jp $2
- $1:
- ld b,0
- ld c,a
- $2:
- ldir
- pop de
- pop bc
- pop hl
- .list
- endm
- ;
- ;fack to format an ack paket
- ;
- f_ack macro
- .xlist
- ld (iy+len),3
- ld a,(n)
- add a,' '
- ld (iy+seq),a
- ld (iy+type),'Y'
- ld hl,spaket
- call acsum
- .list
- endm
- ;
- ;nplus
- ;
- nplus macro
- .xlist
- ld hl,n
- inc (hl)
- res 6,(hl) ;not over 63
- .list
- endm
- ;
- subttl receive initialize
- ;
- ; receive init
- ;
- r_init:
- movb 0,n ;set packet count to 0
- movb 0,r ;and retry count to 0
- ld ix,rpaket ;ix will always point there
- call flush ;flush comm port
- call rpack ;and get a packet
- jp c,rplus ;no good, nack, r+
- ld a,(ix+type) ;get packet type
- cp 'S' ;is it a send ?
- jp nz,abort ;nope, no good
- movb 10,byte ;will move 10 bytes
- blmov rpaket+data,sinit,byte
- ;to send init buffer
- ld hl,sinit+4 ;address of eol
- res 5,(hl) ;sub 32 to get real eol
- ;and prepare to ack
- ;with our parameters
- ld iy,spaket ;iy will always point there
- ld (iy+len),12 ;length
- ld (iy+type),'Y' ;ack
- ld a,(n) ;current packet number
- add a,32 ;make printable
- ld (iy+seq),a ;save in ack packet
- blmov rinit,spaket+data,byte
- ;all the info
- ld hl,spaket ;hl points to send packet
- call acsum ;add checksum
- call spack ;and pray it gets there
- nplus ;increment n
- movb 0,r ;set retry count to 0
- movb _rf,state ;to receive file
- jp mjump ;back
- subttl receive file
- page
- ;
- ; receive file
- ;
- r_file:
- call rpack ;get a packet
- jp c,rplus ;no good
- ld a,(n) ;packet number expected
- add a,' ' ;make printable
- cp (ix+seq) ;equal to received packet
- jp z,rfgood ;yes
- call spack ;re-ack, it was lost
- jp rplus ;increment r, nak
- rfgood:
- jp rfjump
- ;jump according to table
- rf_b:
- ;case(break)
- f_ack ;format ack
- call spack ;and send it
- nplus
- movb _c,state ;set state to complete
- jp mjump ;and back
- rf_x:
- ;case(type on screen)
- movb 1,screen ;set flag on
- movb _rd,state ;set state to receive data
- f_ack ;format ack
- call spack ;and send it
- nplus ;increment packet count
- jp mjump ;and back
- rf_f:
- ;case(file header)
- ld a,(ix+len) ;get lenght
- sub ' '+3 ;minus seq,type, chksum
- ld (ix+len),a ;store back
- blmov rpaket+data,fcb,rpaket
- ;move filename to fcb
- ld hl,fcb ;start of filename
- ld c,a ;length
- ld b,0 ;bc = length
- ld a,'.' ;to scan for dot
- cpir ;found dot
- dec hl ;adjust pointer
- ld (hl),'/' ;replace by '/'
- ld a,0 ;clr a
- cp c ;c = 0 ?
- jp z,r_f0 ;yes, put in cr
- ld hl,fcb ;first byte of filename
- ld a,(rpaket) ;length of filename
- add a,l ;add low byte to length
- ld l,a ;store back low byte
- ld a,0 ;clear a
- adc a,h ;add high byte to carry
- ld h,a ;put back in h
- r_f0: ld (hl),13 ;put in a carriage return
- call open ;and open file
- f_ack ;format an ack
- call spack ;and send it
- nplus ;increment packet count
- movb _rd,state ;set state to receive data
- jp mjump ;and back
- subttl receive data
- page
- ;
- ; receive data
- ;
- r_data:
- call rpack ;get a packet
- jp c,rplus ;no good
- ld a,(n) ;get expected packet count
- add a,' ' ;make printable
- cp (ix+seq) ;equal to received ?
- jp z,rdgood ;yes, all ok
- call spack ;re-ack, it was lost
- jp rplus ;update retry count
- rdgood:
- jp rdjump
- rd_z:
- ;case(end of file)
- call writnx ;flush buffer
- call close ;close file
- f_ack ;format an ack
- call spack ;and send it
- nplus ;increment packet count
- movb _rf,state ;set state to receive file
- jp mjump ;and back
- rd_d:
- ;case(data)
- ld hl,rpaket+data ;start of data
- ld a,(rpaket) ;total length
- sub ' '+3 ;convert to numeric
- cp 0 ;is it null ?
- jp z,rd_d2 ;yes, finish
- ld bc,(recptr) ;pointer inside recbuf
- ld b,0 ;turn off high byte
- push hl ;save temporarily
- ld hl,recbuf ;record address
- add hl,bc ;plus length
- ex de,hl ;pointer in de
- pop hl ;restore hl
- ;at this point :
- ; hl = rpaket
- ; de = inside recbuf
- ; a = length of packet
- rd_d1:
- push af ;save temporarily
- ld a,(hl) ;get current byte
- cp quote ;is it a quote ?
- jr nz,rd_d3 ;no, go on
- inc hl ;point to next byte
- pop af ;restore a
- dec a ;decrement counter
- push af ;and save again
- ld a,(hl) ;get next byte
- cp quote ;is it a quote ?
- jr z,rd_d3 ;yes, don't touch
- cp quote or 128 ;quote and eight bit
- jr z,rd_d3 ;yes don't touch either
- xor 64 ;uncontrollify
- ld (hl),a ;store back
- rd_d3: pop af ;restore
- ldi ;from rapket to recbuf
- dec a ;paket length minus one
- ld bc,(recptr) ;pointer inside recbuf
- inc c ;is incremented
- movb c,recptr ;and stored back
- push af ;save a
- ld a,(lrecl) ;get logical record length
- cp c ;compare to len(recbuf)
- jp nz,rd_d0 ;no, do not update yet
- call writnx ;write next record
- movb 0,recptr ;set pointer back to zero
- ld de,recbuf ;reset pointer to record buffer
- rd_d0:
- pop af ;restore a
- cp 0 ;is packet empty ?
- jp nz,rd_d1 ;no, get one more byte
- rd_d2:
- f_ack ;format an ack
- call spack ;and send it
- nplus ;update packet counter
- jp mjump ;and back
- end
- <<< trssend.mac >>>
- title ksend/mac sending unit
- cseg
- ;
- ;
- extrn recptr,recbuf,rplus,mjump
- extrn spaket,rpaket,screen
- extrn rplus,sinit,state,byte,n,r
- extrn rpack,spack,abort,acsum,flush
- extrn fcb,writnx,open,rinit,close
- extrn lrecl,readnx,buffil,filnam,tstack
- public s_init,s_file,s_open,s_break
- public s_data,s_eof
- ;
- len equ 0
- seq equ 1
- type equ 2
- data equ 3
- quote equ '#'
- _a equ 1
- _c equ 2
- _r equ 3
- _rf equ 4
- _rd equ 5
- _s equ 6
- _sf equ 7
- _sd equ 8
- _se equ 9
- _sb equ 10
- _o equ 11
- ;
- ;
- subttl macros used in this module
- ;
- ;prmes to display messages
- ;
- prmes macro lab
- .xlist
- extrn m_&lab,l_&lab
- push hl
- push bc
- ld hl,m_&lab
- ld bc,(l_&lab)
- ld c,13
- ld a,9
- rst 8
- pop bc
- pop hl
- .list
- endm
- ;movb
- ;
- movb macro value,loc
- .xlist
- push af
- ld a,value
- ld (loc),a
- pop af
- .list
- endm
- ;
- ;blmov
- ;
- blmov macro source,dest,len
- .xlist
- local $1,$2
- push hl
- push bc
- push de
- ld hl,source
- ld de,dest
- ld a,(len)
- cp 0
- jr nz,$1
- ld b,1
- ld c,0
- jp $2
- $1:
- ld b,0
- ld c,a
- $2:
- ldir
- pop de
- pop bc
- pop hl
- .list
- endm
- ;
- ;fack to format an ack paket
- ;
- f_ack macro
- .xlist
- ld (iy+len),3
- ld a,(n)
- add a,' '
- ld (iy+seq),a
- ld (iy+type),'Y'
- ld hl,spaket
- call acsum
- .list
- endm
- ;
- ;nplus
- ;
- nplus macro
- .xlist
- ld hl,n
- inc (hl)
- res 6,(hl)
- movb 0,r
- .list
- endm
- ;
- subttl open file (pseudo-state, precedes send_init)
- page
- ;
- ; open file
- ;
- s_open:
- call open ;open file (assume fcb set)
- movb _s,state ;state = send_init
- movb 0,n ;packet number to 0
- movb 0,r ;reset retry count
- call flush ;clear comm buffers
- jp mjump ;and back
- subttl send initialisation routine
- page
- ;
- ; send init parameters
- ;
- s_init:
- ld ix,rpaket
- ld iy,spaket
- ld (iy+len),12 ;length of init packet
- ld (iy+type),'S' ;type send init
- ld a,(n) ;current packet number
- add a,' ' ;make printable
- ld (iy+seq),a ;into packet
- movb 12,byte ;number of bytes to move
- blmov rinit,spaket+data,byte
- ld hl,spaket ;to point correctly
- call acsum ;compute checksum
- call spack ;and send packet
- ld a,(hl) ;get paket length and fix it
- sub ' ' ;because there might be a retry
- ld (hl),a ;save back
- call rpack ;get answer
- jp c,rplus ;no good
- call tstack ;was it a good ack ?
- jp c,rplus ;no, send it again
- blmov rpaket+data,sinit,byte
- ;move parameters to keep
- ld hl,sinit+4 ;address of eol
- res 5,(hl) ;sub 32 to get real eol
- ld hl,sinit ;maxlen to send
- res 5,(hl) ;sub 32
- nplus ;increment packet count
- movb _sf,state ;state = send file header
- jp mjump ;and back
- subttl send file header information
- page
- ;
- ; send file header
- ;
- s_file:
- ld hl,filnam+1 ;where the filame start
- ld a,(filnam) ;it's length
- ld b,a ;store len in b
- ld a,'/' ;byte to look for
- s1:
- cp (hl) ;is this a '/' ?
- jp z,s2 ;yes change it t '.'
- inc hl ;advance pointer
- djnz s1 ;and check next byte
- jp s3 ;there was no '/'
- s2:
- ld a,'.' ;a dot to normalize filename
- ld (hl),a ;in place
- s3:
- ld (iy+type),'F' ;of type file header
- ld a,(n) ;get packet count
- add a,' ' ;make printable
- ld (iy+seq),a ;insert in spacket
- blmov filnam+1,spaket+data,filnam
- ;put in filename
- ld a,(filnam) ;get filename length
- add a,3 ;add len,seq,type
- ld (iy+len),a ;set in spacket
- ld hl,spaket ;hl to point correctly
- call acsum ;compute checksum
- call spack ;send it
- ld a,(hl) ;get paket length and fix it
- sub ' ' ;because there might be a retry
- ld (hl),a ;save back in spaket
- call rpack ;get answer
- jp c,rplus ;no good
- call tstack ;was it a good ack ?
- jp c,rplus ;no
- nplus ;update packet count
-
- call buffil ;get a bufferfull
- jp c,s_eof ;it was the end of file
- movb _sd,state ;state = send_data
- jp mjump ;return
- subttl send data from file
- page
- ;
- ; send data
- ;
- s_data:
- ld (iy+type),'D' ;data packet
- ld a,(n) ;packet number
- add a,' ' ;make printable
- ld (iy+seq),a ;into packet
- ld hl,spaket ;hl point correctly
- call acsum ;compute checksum
- call spack ;send it
- ld a,(hl) ;get length to fix it in case
- sub ' ' ; of a bad ack
- ld (hl),a ;save back in spaket
- call rpack ;get answer
- jp c,rplus ;no good
- call tstack ;a good ack ?
- jp c,rplus ;nope...
- nplus ;yes, update packet count
- call buffil ;get next packet ready
- jp c,s_eof ;we reach the eof
- jp mjump ;and back
- subttl send end of file
- page
- ;
- ; send end of file
- ;
- s_eof:
- movb _se,state ;might not be done
- ld (iy+type),'Z' ;eof in spacket
- ld (iy+len),3 ;length
- ld a,(n) ;packet number
- add a,' ' ;make printable
- ld (iy+seq),a ;into packet
- ld hl,spaket ;to point correctly
- call acsum ;compute checksum
- call spack ;send packet
- ld a,(hl) ;get paket length
- sub ' ' ;and fix it
- ld (hl),a ;back in spaket
- call rpack ;get answer
- jp c,rplus ;no good
- call tstack ;test for good ack
- jp c,rplus ;no good
- nplus ;good, update packet count
- movb _sb,state ;state = break transmission
- jp mjump ;and back
- subttl send break transmission
- page
- ;
- ; send break transmission
- ;
- s_break:
- ld (iy+type),'B' ;in spaket, set type
- ld (iy+len),3 ;and length
- ld a,(n) ;current packet number
- add a,' ' ;make printable
- ld (iy+seq),a ;store in spaket
- ld hl,spaket ;hl to point correctly
- call acsum ;compute checksum
- call spack ;send packet
- ld a,(hl) ;get paket length and fix it
- sub ' ' ;there might be a retry
- ld (hl),a ;save back in spaket
- call rpack ;get answer
- jp c,rplus ;no good
- call tstack ;check if correct ack
- jp c,rplus ;no, send again
- movb _c,state ;complete
- jp mjump ;FIN...
- end
- <<< trsutil.mac >>>
- subttl kutil/mac utilities and other odd routines
- extrn rlen,slen,csvc,rsvc,ssvc,r,n,mjump
- extrn spaket,rpaket,byte,recptr,sinit
- extrn fcb,lrecl,filbuf,recbuf,lrecl,paraml
- public flush,rplus,abort,exit,acsum,spack
- public open,close,writnx,readnx,kill
- public rpack,initcm
- extrn init,port,altsvc,nsvc
- ;
- ; useful symbole
- ;
- soh equ 1
- tout equ 10
- len equ 0
- seq equ 1
- type equ 2
- data equ 3
- dfport equ 'A'
- ;
- ;
- ;timer to interrupt a given routine after a number of seconds
- ; syntax timer routin,seconds
- ; where routin is the interrupt handler
- ;
- timer macro routin,second
- push hl
- push bc
- ld hl,routin ;routine to jump to
- ld bc,second ;number of seconds
- svc 25 ;timer call
- pop bc
- pop hl
- endm
- ;
- ;svc to make a trsdos supervisor call
- ; syntax svc code
- ; where code is the trsdos code
- ;
- svc macro code
- ld a,code
- rst 8
- endm
- ;
- ;
- ;prmes to print messages on the screen
- ; syntax prmes lab
- ; where lab if the label as defined with mssg
- ;
- prmes macro lab
- .xlist
- extrn m_&lab,l_&lab
- push hl
- push bc
- ld hl,m_&lab ;get address of message
- ld bc,(l_&lab) ;and length
- ld c,13 ;add a CR at end of ttyout
- svc 9 ;call dos
- pop bc
- pop hl
- .list
- endm
- ;
- ;blmov to move a block of text
- ; syntax blmov source,destination,length
- ; if length is 0 then assume 256
- ;
- blmov macro source,dest,len
- .xlist
- local $1,$2
- push hl
- push bc
- push de
- ld hl,source ;address of source
- ld de,dest ;address of destination
- ld a,(len) ;get length
- cp 0 ;is it zero ?
- jr nz,$1
- ld b,1 ;then set bc = 256
- ld c,0 ;(b=1 ; c=0)
- jp $2 ;go to start move
- $1:
- ld b,0
- ld c,a ;bc = length
- $2:
- ldir ;move and check if bc=0
- pop de
- pop bc
- pop hl
- .list
- endm
- ;
- ;readnx to read next record sequentially
- ; Returs with the record in recbuf
- ; And, at eof, will jump to sendeof
- ; (This macro will not save redisters)
- ;
- readnx:
- ld de,fcb ;file control block
- svc 34 ;read next svc
- jp nz,abort ;bad read, abort
- ld a,(lrecl) ;get logacal record length
- cp 0 ;is it 256 ?
- jp nz,read0 ;no, all is ok
- blmov filbuf,recbuf,lrecl ;move to recbuf
- read0:
- ret
- ;
- ;open open a file according to fcb and paramlist
- ;
- open:
- push hl
- push de
- ld de,fcb ;file control block
- ld hl,paraml ;parameter list
- svc 40 ;open call
- jp nz,abort ;file not found
- ;or file cannot create
- pop de
- pop hl
- ret
- ;
- ;kill kill a file using current fcb
- ;
- kill:
- push de
- ld de,fcb ;file control block
- svc 41 ;kill call
- jp nz,abort ;no good (password ?)
- pop de
- ret
- ;
- ;close file using current fcb
- ;
- close:
- push de
- ld de,fcb
- svc 42
- jp nz,abort
- xor a ;clr a
- ld (recptr),a ;reset pointer to 0
- pop de
- ret
- ;
- ;writnx write next sequential record
- ;
- writnx:
- ld a,(lrecl) ;get logical record length
- cp 0 ;is it 256 ?
- jp nz,writ0 ;no, go on
- blmov recbuf,filbuf,lrecl ;get to filbuf
- writ0:
- push de
- ld de,fcb ;file control block
- svc 43 ;write call
- jp nz,abort ;no good
- pop de
- ret
- ;
- ;delay in seconds
- ;
- delay macro sec
- .xlist
- local $1
- push bc
- ld bc,0 ;set for 426 milisecs
- push hl
- ld l,sec ;number of seconds
- $1:
- svc 6 ;call for delay
- svc 6 ;2 * 426 milisecs = 1 s.
- dec l ;sec--
- xor a ;a = 0
- cp l ;sec = 0 ?
- jr nz,$1 ;no, play it again sam
- pop hl
- pop de
- .list
- endm
- ;
- ;jumptb jump according to a given table and a one byte code
- ;
- ; syntax jumptb table,code
- ;
- jumptb macro table,code
- .xlist
- local $1
- ld hl,table ;get jump table address
- ld bc,(code) ;and code (note that c is messed up)
- ld a,c
- ld b,a
- svc 28 ;lookup call
- jr z,$1 ;found
- ld hl,table+1 ;get abort address
- $1:
- jp (hl) ;bye ...
- .list
- endm
- ;
- ;initcm initalise comm channel A or B
- ; and set up correct svc communication calls
- ;
- initcm:
- ld a,(init) ;get initial code
- cp 0 ;should we init ?
- jr z,i1 ;no, go set up svc
- ;
- ld hl,port ;get port paramlist
- ld b,0 ;turn off port
- svc 55 ;dos call
- ld b,1 ;turn on
- svc 55 ;dos call
- i1:
- ld a,(port) ;get channel A or B
- cp dfport ;is this default ?
- jr z,i2 ;yes, all ok
- blmov altsvc,init,nsvc;set up alternate svc's
- i2:
- ret
- ;
- ;xmitb transmit a byte that is pointed to by hl
- ;
- xmitb macro
- .xlist
- local $1
- $1:
- ld a,(ssvc) ;get transmit svc
- ld b,(hl) ;and byte to transmit
- rst 8 ;dos call
- jr nz,$1 ;assume busy, try again
- .list
- endm
- ;
- ;rcvb receive byte and return it in a
- ;
- rcvb macro
- .xlist
- local $1
- push bc
- $1:
- ld a,(rsvc) ;get receive svc
- rst 8 ;dos call
- jr nz,$1 ;try it again
- ld a,b ;store (might not be good)
- pop bc
- .list
- endm
-
- ;
- ;nplus to increment the packet number count
- ;
- nplus macro
- ld hl,n
- inc (hl)
- endm
- ;
- ;dec3 decrement three times a register or register pair
- ;
- dec3 macro reg
- dec reg
- dec reg
- dec reg
- endm
- ;
- ;addbc to add a to bc in checksum computation
- ;
- addbc macro
- .xlist
- add a,c ;c=c+1 (there might be a carry)
- ld c,a ;back in c
- ld a,0 ;not xor a because we need the carry
- adc a,b ;add the carry to b
- ld b,a ;back in b
- .list
- endm ;bc=bc+a
- ;
- ;f_ack to format ack using current n
- ;
- f_ack macro
- .xlist
- ld (iy+len),3 ;length=3
- ld a,(n) ;current packet count
- add a,' ' ;make printable
- ld (iy+seq),a ;put n in packet
- ld (iy+type),'Y' ;type = ack
- ld hl,spaket ;hl points to send packet
- call acsum ;and add the checksum
- .list
- endm
- ;
- ;movb to move a byte to memory
- ;
- movb macro value,loc
- .xlist
- push af ;save
- ld a,value ;get byte
- ld (loc),a ;save
- pop af ;restore
- .list
- endm
- subttl rpack - receive packet routine
- page
- ;
- ; rpack receive packet routine
- ; call rpack
- ; will discard soh on reception
- ; and will return with carry set
- ; if timout occured or cheksum wrong
- ;
- rpack:
- timer rp0,tout ;set timer handler
- rp1:
- ld hl,rpaket ;set up hl
- rcvb ;get a byte
- cp soh ;is it a soh ?
- jr nz,rp1 ;no, not yet, start over
- ld b,0 ;for checksum bc=0
- ld c,0 ;*****************
- rp2: ;len
- rcvb ;get a byte
- cp soh ;is it a soh ?
- jp z,rp1 ;yes, re-sync
- ld (hl),a ;save in rpaket
- addbc ;add to bc for checksum
- ld a,(hl) ;get back byte
- inc hl ;point to next byte
- sub ' '+3 ;convert to numeric
- ld (rlen),a ;and save
- rp3: ;packet number
- rcvb ;get a byte
- cp soh ;soh ?
- jp z,rp1 ;yes, re-sync
- ld (hl),a ;save in rpaket
- inc hl ;update counter
- addbc ;add to bc for checksum
- rp4: ;type of packet
- rcvb ;get a byte
- cp soh ;soh ?
- jp z,rp1 ;yes, re-sync
- ld (hl),a ;save in rapket
- inc hl ;update pointer
- addbc ;add to bc for checksum
- ld a,(rlen) ;get data length
- cp 0 ;is it null ?
- jp z,rp6 ;yes, get checksum now
- rp5: ;data field
- rcvb ;get a byte
- cp soh ;soh ?
- jp z,rp1 ;yes, re-sync
- ld (hl),a ;save
- inc hl ;update counter
- addbc ;add to bc for checksum
- ld a,(rlen) ;get length of packet
- dec a ;decrement
- ld (rlen),a ;ans store back
- cp 0 ;is it null ?
- jp nz,rp5 ;no, get one more byte
- rp6: ;checksum
- rcvb ;get a byte
- cp soh ;soh ???
- jp z,rp1 ;yes, re-sync
- sub ' ' ;convert to numeric
- ld (byte),a ;save received checksum
- ld a,c ;get low byte
- and 300O ;only two high bits
- rlca ;rotale left
- rlca ;twice
- add a,c ;add back to low byte
- and 077O ;only six bits
- ld c,a ;computed checksum
- ld a,(byte) ;received checksum
- cp c ;equal ?
- jp nz,rp0 ;no good
- timer 0,0 ;terminate timout handler
- scf ;ser carry to 1
- ccf ;back to 0
- ret ;and return
- rp0: timer 0,0 ;terminate timout handler
- scf ;set carry flag
- ret
- ;
- ;
- subttl flush - to reset communication port
- page
- ;
- ; flush to reset internal communication buffer
- ; (mostly to get rid of stacked up naks)
- flush:
- push bc ;save
- ld b,6 ;code to reset buffer
- ld a,(csvc) ;control svc
- rst 8 ;dos call
- pop bc ;restore
- ret
- ;
- subttl rplus - to increment retry count
- page
- ; rplus increment retry count and jump back
- ;
- rplus:
- ld a,(r) ;get retry count
- inc a ;increment it
- cp tout ;to maximum ?
- jp z,abort ;yes abort
- ld (r),a ;save back
- jp mjump ;and go back
- ;
- subttl abort - end in disaster sending an error packet
- page
- ; abort end transmission and die...
- ;
- abort:
- prmes a0 ;aborting ...
- ld (iy+len),3 ;length = 3
- ld a,(n) ;get current packet seq
- cp 0 ;are we at beginning ?
- jp z,ab0 ;yes, do not send error pak
- add a,' ' ;make printable
- ld (iy+seq),a ;and store
- ld (iy+type),'E' ;type error packet
- ld hl,spaket ;set up hl
- call acsum ;compute checksum
- call spack ;and send packet
- ab0:
- exit: prmes e0 ;end of job
- rst 0 ;bye !
- ;
- subttl acsum - add checksum to a packet
- page
- ; acsum compute and store checksum (hl)
- ;
- acsum:
- push hl ;save
- push bc ;save
- ld b,0 ;initialize bc to 0
- ld c,0 ;******************
- ld a,(hl) ;get length
- ld (slen),a ;save it
- add a,' ' ;make printable
- ld (hl),a ;store back in packet
- ac0:
- ld a,(hl) ;get a byte
- addbc ;add to bc for checksum
- inc hl ;increment pointer
- ld a,(slen) ;get length
- dec a ;decrement it
- ld (slen),a ;save it back
- cp 0 ;are we at end ?
- jp nz,ac0 ;no, get one more byte
- ld a,c ;get low byte of sum
- and 300O ;only 2 high bits
- rlca ;rotate left
- rlca ;twice
- add a,c ;add it back to low byte
- and 077O ;mask off 2 high bits
- add a,' ' ;and make pintable
- ld (hl),a ;store in packet
- pop bc ;restore
- pop hl ;restore
- ret
- ;
- subttl spack - send a packet already formatted
- page
- ; spack send a packet already formatted
- ;
- spack:
- push hl ;save
- ld a,(spaket) ;get length
- sub 31 ;real length
- ld (slen),a ;save it
- movb soh,byte ;store a soh
- ld hl,byte ;set up hl
- xmitb ;transmit (hl)=soh
- ld hl,spaket ;packet address
- ld a,(slen) ;and length
- sp1:
- push af ;save
- xmitb ;transmit (hl)
- pop af ;restore a
- dec a ;decrement length of packet
- inc hl ;update pointer
- cp 0 ;are we at end ?
- jp nz,sp1 ;no, one more byte
- ;now send eol
- ld hl,sinit+4 ;where eol is stored
- xmitb ;send it
- pop hl ;restore
- ret
- ;
- ;
- end
-
- <<< trsutil2.mac >>>
- subttl kutil2/mac utilities and other odd routines
- extrn rlen,slen,csvc,rsvc,ssvc,r,n,mjump
- extrn spaket,rpaket,byte,recptr,sinit
- extrn fcb,lrecl,filbuf,recbuf,lrecl,paraml
- extrn readnx,crp,cbp,word
- public tstack,buffil,eof
- ;
- ; useful symbols
- ;
- soh equ 1
- tout equ 10
- len equ 0
- seq equ 1
- type equ 2
- data equ 3
- dfport equ 'A'
- ;
- ;
- ;
- ;svc to make a trsdos supervisor call
- ; syntax svc code
- ; where code is the trsdos code
- ;
- svc macro code
- ld a,code
- rst 8
- endm
- ;
- ;
- ;prmes to print messages on the screen
- ; syntax prmes lab
- ; where lab if the label as defined with mssg
- ;
- prmes macro lab
- .xlist
- extrn m_&lab,l_&lab
- push hl
- push bc
- ld hl,m_&lab ;get address of message
- ld bc,(l_&lab) ;and length
- ld c,13 ;add a CR at end of ttyout
- svc 9 ;call dos
- pop bc
- pop hl
- .list
- endm
- ;
- ;blmov to move a block of text
- ; syntax blmov source,destination,length
- ; if length is 0 then assume 256
- ;
- blmov macro source,dest,len
- .xlist
- local $1,$2
- push hl
- push bc
- push de
- ld hl,source ;address of source
- ld de,dest ;address of destination
- ld a,(len) ;get length
- cp 0 ;is it zero ?
- jr nz,$1
- ld b,1 ;then set bc = 256
- ld c,0 ;(b=1 ; c=0)
- jp $2 ;go to start move
- $1:
- ld b,0
- ld c,a ;bc = length
- $2:
- ldir ;move and check if bc=0
- pop de
- pop bc
- pop hl
- .list
- endm
- movb macro value,loc
- .xlist
- push af
- ld a,value
- ld (loc),a
- pop af
- .list
- endm
- ;
- ;
- ; tstack to test a received packet for a good ack
- ;
- tstack:
- ld a,(n) ;cirrent packet count
- add a,' ' ;make printable
- cp (ix+seq) ;equal to seq received ?
- jp nz,plus1 ;no, test n+1
- ld a,(ix+type) ;get packet type
- cp 'Y' ;is an ack ?
- jp nz,nogood ;no return error code
- $1:
- scf
- ccf
- ret ;return no error
- plus1:
- inc a ;increment packet count
- cp (ix+seq) ;equal to received ?
- jp z,$1 ;yes, all ok
- nogood:
- scf ;set carry
- ret
- ;
- ; buffil to fill a send packet data field from
- ; record buffer
- ;
- buffil:
- movb 3,cbp ;initialize buffer pointer
- b5:
- ld a,(cbp) ;get buffer pointer
- inc a ;it might be one less
- ld hl,sinit ;maxlen to send
- cp (hl) ;equal to max or max-1 ?
- jp c,b0 ;no, there is room
- b4:
- ld a,(cbp) ;buffer pointer
- ld (iy+len),a ;in packet
- scf
- ccf
- ret ;return all ok
- b0:
- xor a ;clear a
- ld hl,crp ;record pointer address
- cp (hl) ;buffer empty ?
- jp nz,b1 ;no
- call readnx ;get something (EOF...)
- jp nc,b1 ;not end of file yet
- ld a,(cbp) ;spaket pointer
- ld (iy+len),a ;put in place
- cp 3 ;is this the start ?
- jp nz,b13 ;not yet, return normally
- scf ;flag to never return here
- b13: ret
- b1:
- ld a,(cbp) ;buffer pointer
- ld b,a ;save in b
- ld a,(sinit) ;maxlen to send
- sub b ;a=SA=mxl-cbp
- ld (byte),a ;save in byte
- ld a,(crp) ;record pointer
- ld b,a ;save in b
- ld a,(lrecl) ;record length
- sub b ;a=BA=lrecl-crp
- ld hl,byte ;get byte address
- cp (hl) ;BA > SA ?
- jp nc,b2 ;go move SA bytes
- ld (byte),a ;save BA in byte
- b2:
- ld hl,spaket ;packet address
- ld a,(cbp) ;current pointer
- add a,l ;add to low byte
- ld l,a ;save back
- ld a,0 ;clear a keeping carry
- adc a,h ;add carry to high byte
- ld h,a ;save back
- ex de,hl ;save in DE
- ld hl,recbuf ;record address
- ld a,(crp) ;record pointer
- add a,l ;add to low byte
- ld l,a ;save back
- ld a,0 ;clear a keeping carry
- adc a,h ;add to high byte
- ld h,a ;save back
- ;
- ; here we move from recbuf to spaket
- ; making sure the control caracters are quoted,
- ; and uncontrollified (same thing for del),
- ; and that the quote caracter is itself quoted.
- ;
- movb 0,word ;this will be the count from recbuf
- movb 0,word+1 ;and the count of quote bytes
- b9:
- ld a,31 ;limit of control char.
- ld b,(hl) ;get character in b to
- res 7,b ; reset seventh bit
- cp b ;compare 31 to byte to send
- jp c,b6 ;this is not a control char.
- b8:
- ld a,(sinit+5) ;get the quote byte
- ld (de),a ;move in spaket
- inc de ;update spaket pointer
- push hl ;save
- ld hl,word+1 ;points to quote count
- inc (hl) ;update count
- pop hl ;restore
- ld a,64 ;to uncontrollify
- xor (hl) ;the byte to send
- ld (hl),a ;and put it back in recbuf
- jp b7 ;go send it
- b6:
- ld a,127 ;del byte
- cp b ;is this it ?
- jp z,b8 ;yes go uncontrollify it
- ;
- ld a,(sinit+5) ;quote byte
- cp (hl) ;is this what we are sending ?
- jp nz,b7 ;no, go on
- ld (de),a ;yes put it in spaket
- inc de ;and update pointer
- push hl ;save
- ld hl,word+1 ;get quote count address
- inc (hl) ;and update it
- pop hl ;restore hl
- b7:
- ldi ;move the byte in spaket
- push hl ;save
- ld hl,word ;count address
- inc (hl) ;update it
- ld a,(hl) ;get count of bytes from recbuf
- ld hl,word+1 ;and count of quote bytes
- add a,(hl) ;add them to get real count
- ld hl,byte ;address of max to moved
- inc a ;increment real count
- ; to get to max-1 or max
- cp (hl) ;compare count+1 to max
- jp nc,b10 ;this is it, finish.
- pop hl ;restore
- jp b9 ;one more time...
- b10:
- ld a,(word) ;real count moved from recbuf
- ld (byte),a ;put where we need it
- pop hl ;restore to recbuf
- b11:
- ;
- ; at this point we have moved up to (byte) bytes
- ; maby less if there was only one control character
- ; Most of those bytes come from recbuf plus some
- ; instances of the quote byte.
- ;
- ld a,(word) ;number of bytes moved
- ld hl,word+1 ;address of quote count
- add a,(hl) ;a = total count
- ld hl,cbp ;buffer pointer
- add a,(hl) ;increment
- ld (hl),a ;save back in cbp
- ld hl,crp ;record pointer
- ld a,(word) ;get back bytes moved from rec
- add a,(hl) ;fix pointer
- ld (hl),a ;save back in cbp
- ld a,(lrecl) ;record length
- cp (hl) ;equal to record pointer ?
- jp nz,b3 ;no, go on
- movb 0,crp ;yes, reset crp
- b3:
- jp b5 ;one more time
- ;
- ; eof this routine will be accessed automatically
- ; from a read of eof by trsdos.
- ; Might be accessed twice ...
- ;
- eof:
- scf ;set carry
- ret
- end
-
